home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / jbanner2.zip / BANNER.ZIP / BANNER.PRG next >
Text File  |  1987-03-30  |  3KB  |  100 lines
  1. ******************************************************************************
  2. * (C) JOHN A. BRISTOR ,1987
  3. * ALL RIGHTS RESERVED
  4. *
  5. * 8414 Williamsburg Circle
  6. * Pensacola, FL 32514
  7. * Voice (904) 474-8846
  8. * Data (704) 264-7381    FIDO : 151/305
  9. *
  10. * BANNER.PRG : Procedure SC428 from Screen Control Procedure Archives
  11. *
  12. * BANNER.PRG : Standard "running" left to right message scroller.
  13. *
  14. *      This is a standard routine for displaying scrolling messages from left
  15. * to right.
  16. *
  17. * PARAMETERS :
  18. *           PBANNER --> String containing message
  19. *               MIN. Length - 2 chars
  20. *               MAX. Length - 78 chars
  21. *
  22. *           PWAIT ----> Whether routine waits for keypress or not.
  23. *               VALUES - Y or N
  24. *
  25. *           PTIMER ---> Variable for time delay length
  26. *               EXAMPLE -  15 works good for 8mhz, 80286 CPU
  27. *
  28. *           PLINE ----> Line (Row) on screen used for scrolling message
  29. *               MIN -  0
  30. *               MAX - 24
  31. *
  32. * EXAMPLE of how to call procedure from another program
  33. *
  34. *       STORE "Y" TO PWAIT
  35. *       STORE "Press any key to enter program..." TO PBANNER
  36. *       STORE 15 TO PTIMER
  37. *       STORE 23 TO PLINE
  38. *       STORE LASTKEY() TO PLAST
  39. *       SET PROCEDURE TO BANNER
  40. *       DO PRESS1 WITH PBANNER,PWAIT,PTIMER,PLINE,PLAST
  41. *       CLOSE PROCEDURE
  42. *
  43. *
  44. * COMPILER - Clipper, Winter'85, Autumn'86
  45. * LINKING -  Must be Linked with SCRL.OBJ (SCRL.ASM by Thomas E. Link
  46. *
  47. *****************************************************************************
  48.  
  49. PROCEDURE PRESS1
  50. PARAMETERS QBANNER,QWAIT,QTIMER,QLINE,QLAST
  51.  
  52. STORE LEN(QBANNER) TO NUMCHARS
  53. STORE INT((80-LEN(QBANNER))/2) TO STARTPT
  54. STORE "N" TO PRESSFLAG
  55. DO WHILE LASTKEY() = QLAST .AND. PRESSFLAG = "N"
  56.      IF QWAIT = "N"
  57.       STORE "Y" TO PRESSFLAG
  58.      ENDIF
  59.      FOR KOUNT = NUMCHARS TO 1 STEP -1
  60.       STORE SUBSTR(QBANNER,KOUNT,1) TO PCHAR
  61.       IF PCHAR = "." .AND. (NUMCHARS - KOUNT) <=3
  62.            SET COLOR TO W*/N
  63.       ENDIF
  64.       @ 23, 0 SAY PCHAR
  65.       SET COLOR TO W/N
  66.       call ascroll with chr(2),chr(1),chr(15),chr(QLINE),chr(0),chr(QLINE),chr(79)
  67.       DO DELAYb WITH QTIMER
  68.       INKEY(.03)
  69.       IF LASTKEY() <> QLAST .AND. QWAIT = "Y"
  70.            RETURN
  71.       ENDIF
  72.      NEXT KOUNT
  73.  
  74.      FOR I = 1 to 79
  75.       IF I = STARTPT .AND. QWAIT = "Y"
  76.            FOR NEAT = 1 TO INT(QTIMER/2)
  77.             DO DELAYb WITH QTIMER*4
  78.             INKEY(.03)
  79.             IF LASTKEY() <> QLAST
  80.              RETURN
  81.             ENDIF
  82.            NEXT NEAT
  83.       ENDIF
  84.       call ascroll with chr(2),chr(1),chr(15),chr(QLINE),chr(0),chr(QLINE),chr(79)
  85.       DO DELAYb WITH QTIMER
  86.       INKEY(.03)
  87.       IF LASTKEY() <> QLAST .AND. QWAIT = "Y"
  88.            RETURN
  89.       ENDIF
  90.      NEXT I
  91. ENDDO
  92. STORE " " TO QWAIT
  93. RETURN
  94.  
  95. PROCEDURE DELAYb
  96. PARAMETERS ZTIMER
  97. FOR TIMER = 1 TO ZTIMER
  98. NEXT TIMER
  99. RETURN
  100.